home *** CD-ROM | disk | FTP | other *** search
/ CD ROM Paradise Collection 4 / CD ROM Paradise Collection 4 1995 Nov.iso / program / swagg_m.zip / GRAPHICS.SWG / 0162_Capture-Restore Graphics Screen.pas < prev    next >
Pascal/Delphi Source File  |  1995-03-03  |  16KB  |  614 lines
  1.  
  2. {Hi !!!
  3.  
  4.  Thanx for answering on my mail, here are two sources which i grabed from
  5.  Data Master 1.0 for VGA, it will probably work on other cards, but i tested
  6.  them only on VGA 640x480x16 in Turbo Pascal 7.0
  7.  
  8.  There are two sources:
  9.  1. SaveScn.Pas       (Capture Graphical Screens to file)
  10.     Creates simple Graphical look of screen, and save it to file.
  11.     All procedures are independent and can be cuted to another programs
  12.     which deal with graphics. It can save all or just a part of screen.
  13.     Procedures Ikona and BIkona are taked from unit Grafika and they are
  14.     creation of Kristijan Lukacin (programmer for graphics on Data Master, 
  15.     i deal with files, and other non-graphics, or with little graphics parts 
  16.     of program).
  17.  
  18.  2. ReadScrn.Pas      (Reading and Showing Saved Images)
  19.     This will show saved image to screen (here isn't solved showing saved
  20.     images of edge of screen, if ANY part of saved image goes over screen
  21.     edge nothing will be showed on screen).
  22.   
  23.  
  24. Thanx !!!
  25.  
  26.                 AMATRIX Software Developement Coorporation
  27.                              1994, Croatia
  28.                        Communication with us thrue
  29.  
  30.         E-mail: piko@cromath.math.hr
  31.  
  32.         Snail mail: Varoska 67
  33.                     41040 Zagreb
  34.                     Croatia
  35.  
  36.                     Markusevacka cesta
  37.                     41000 Zagreb
  38.                     Croatia
  39.  
  40.         Fax/Phone: (99 385)(0)41 283 505,  contact person Kresimir Mihalj
  41.                    (99 385)(0)41 277 221,  contact person Kristijan Lukacin
  42.  
  43. }
  44.  
  45. {***************************************************************************}
  46.  
  47. {             Save all or just part of graphical screen to file
  48.  
  49. {***************************************************************************}
  50. PROGRAM SaveImage;
  51. USES Graph, Dos, CRT;
  52. Var GD, GM: Integer;
  53.     hmm: Boolean;
  54.  
  55. Procedure CIkona(x1,y1,x2,y2,text:integer;tekstikone:string); {Ikone}
  56.   Begin
  57.    SetColor(White);
  58.    SetFillStyle(SolidFill,2);
  59.    Bar(x1,y1,x2,y2);
  60.    SetColor(Black);
  61.    SetLineStyle(0,0,1);
  62.    Rectangle(x1-1,y1-2,x2+1,y2+1);
  63.    SetColor(White);
  64.    Line(x1,y1-1,x2,y1-1);
  65.    Line(x1,y1,x1,y2-1);
  66.    SetColor(DarkGray);
  67.    Line(x1+1,y2,x2,y2);
  68.    Line(x2,y2,x1,y2);
  69.    SetTextStyle(0,0,0);
  70.    SetColor(DarkGray);
  71.    OutTextXY(x1+5,y1+4+text,TekstIkone);
  72.    SetColor(White);
  73.    OutTextXY(x1+3,y1+2+text,TekstIkone);
  74.   end {Ikona};
  75.  
  76. Procedure Ikona(x1,y1,x2,y2,text:integer;tekstikone:string); {Ikone}
  77.   Begin
  78.    SetColor(White);
  79.    SetFillStyle(SolidFill,LightGray);
  80.    Bar(x1,y1,x2,y2);
  81.    SetColor(Black);
  82.    SetLineStyle(0,0,1);
  83.    Rectangle(x1-1,y1-2,x2+1,y2+1);
  84.    SetColor(White);
  85.    Line(x1,y1-1,x2,y1-1);
  86.    Line(x1,y1,x1,y2-1);
  87.    SetColor(DarkGray);
  88.    Line(x1+1,y2,x2,y2);
  89.    Line(x2,y2,x1,y2);
  90.    SetTextStyle(0,0,0);
  91.    SetColor(DarkGray);
  92.    OutTextXY(x1+5,y1+4+text,TekstIkone);
  93.    SetColor(White);
  94.    OutTextXY(x1+3,y1+2+text,TekstIkone);
  95.   end {Ikona};
  96.  
  97. Procedure BIkona(x1,y1,x2,y2,text:integer;tekstikone:string);  {Stisnuta Ikona}  Begin
  98.    SetColor(White);
  99.    SetFillStyle(SolidFill,LightGray);
  100.    Bar(x1,y1,x2,y2);
  101.    SetColor(Black);
  102.    SetLineStyle(0,0,1);
  103.    Rectangle(x1-1,y1-2,x2+1,y2+1);
  104.    SetColor(Black);
  105.    Line(x1,y1-1,x2,y1-1);
  106.    Line(x1,y1,x1,y2-1);
  107.    SetColor(DarkGray);
  108.    Line(x1+1,y2,x2,y2);
  109.    Line(x2,y2,x1,y2);
  110.    SetTextStyle(0,0,0);
  111.    SetColor(White);
  112.    OutTextXY(x1+5,y1+4+text,TekstIkone);
  113.    SetColor(DarkGray);
  114.    OutTextXY(x1+3,y1+2+text,TekstIkone);
  115.    Delay(300);
  116.   end {Bikona};
  117.  
  118.  
  119. PROCEDURE Make_Amatrix_Image_Data;
  120. VAR ch: Char;
  121.     k:LongInt;
  122.     st: String;
  123.     d: Text;
  124.     e,z,w: File Of Char;
  125. BEGIN
  126.      Assign(d,'IMAGE.AID');
  127.      Rewrite(d);
  128.      Writeln(d,'Amatrix Image Data Version 1.0 (c) 1994 by Amatrix');
  129.      Writeln(d, 'Developed By Kresimir Mihalj');
  130.      Writeln(d);
  131.      Write(d,'AISD/3 ');
  132.      k:=0;
  133.      Assign(e,'IMAGE2.TMP');
  134.      Reset(e);
  135.      WHILE Not Eof(e) DO
  136.      BEGIN
  137.           Read(e,Ch);
  138.           k:=k+1;
  139.      END;
  140.      Append(d);
  141.      Reset(e);
  142.      Writeln(d,k);
  143.      WHILE Not Eof(e) DO
  144.      BEGIN
  145.           Read(e,Ch);
  146.           Write(d,Ch);
  147.      END;
  148.      Close(e);
  149.      Append(d);
  150.      Writeln(d);
  151.      Write(d,'AIDD/3 ');
  152.      k:=0;
  153.      Assign(w,'IMAGE3.TMP');
  154.      Reset(w);
  155.      WHILE Not Eof(w) DO
  156.      BEGIN
  157.           Read(w,Ch);
  158.           k:=k+1;
  159.      END;
  160.      Reset(w);
  161.      Writeln(d,k);
  162.      WHILE Not Eof(w) DO
  163.      BEGIN
  164.           Read(w,Ch);
  165.           Write(d,Ch);
  166.      END;
  167.      Writeln(d);
  168.      Close(w);
  169.  
  170.      Write(d,'AID/3 ');
  171.      Assign(z,'IMAGE1.TMP');
  172.      Reset(z);
  173.      k:=0;
  174.      WHILE Not Eof(z) DO
  175.      BEGIN
  176.           Read(z,Ch);
  177.           k:=k+1;
  178.      END;
  179.      Reset(z);
  180.      Writeln(d,k);
  181.      WHILE Not Eof(z) DO
  182.      BEGIN
  183.           Read(z,Ch);
  184.           Write(d,Ch);
  185.      END;
  186.      Close(z);
  187.      Close(d);
  188. END;
  189.  
  190. PROCEDURE Save_Image_in_Temp_Files(X1,Y1,X2,Y2: Integer);
  191. VAR Size,Result: Word;
  192.     P: Pointer;
  193.     Ch: Char;
  194.     yy1,yy2,k: Integer;
  195.     g: File of Word;
  196.     h: File of Integer;
  197.     f: File;
  198.  
  199. BEGIN
  200.      Assign(F,'IMAGE1.TMP');
  201.      reWrite(F,1);
  202.      Assign(g, 'IMAGE2.TMP');
  203.      Rewrite(g);
  204.      Assign(h, 'IMAGE3.TMP');
  205.      Rewrite(h);
  206.      k:=(Y2-Y1) DIV 3;
  207.      Write(h,k);
  208.      Size:=ImageSize(x1,y1,x2,y1+k);
  209.      Write(g,Size);
  210.      GetMem(P,Size);
  211.      GetImage(x1,y1,x2,y1+k,P^);
  212.      BlockWrite(F,P^,Size,Result);
  213.      if Ioresult <> 0 then Halt(2);
  214.      FreeMem(P,Size);
  215.  
  216.      Size:=ImageSize(x1,y1+k,x2,y1+(k*2));
  217.      Write(g,Size);
  218.      GetMem(P,Size);
  219.      GetImage(x1,y1+k,x2,y1+(k*2),P^);
  220.      BlockWrite(F,P^,Size,Result);
  221.      if Ioresult <> 0 then Halt(2);
  222.      FreeMem(P,Size);
  223.  
  224.      Size:=ImageSize(x1,y1+(k*2),x2,y2);
  225.      Write(g,Size);
  226.      GetMem(P,Size);
  227.      GetImage(x1,y1+(k*2),x2,y2,P^);
  228.      BlockWrite(F,P^,Size,Result);
  229.      if Ioresult <> 0 then Halt(2);
  230.      FreeMem(P,Size);
  231.      Make_Amatrix_Image_Data;
  232.      Rewrite(f);
  233.      close(F);
  234.      Erase(f);
  235.      Rewrite(g);
  236.      Close(g);
  237.      Erase(g);
  238.      Rewrite(h);
  239.      Close(h);
  240.      Erase(h);
  241. END;
  242.  
  243.  
  244.  
  245. BEGIN
  246.      Gd:=Detect;
  247.      InitGraph(Gd, Gm, '\turbo\tp\');  { CHANGE THIS !!! }
  248.      if GraphResult <> grOk then Halt(1);
  249. {********* Create some graphics *********}
  250.      ikona(200,160,440,380,0,' ');
  251.      Bikona(205,165,435,375,0,' ');
  252.      Ikona(210,170,430,195,0,' ');
  253.      Ikona(210,202,430,245,0,' ');
  254.      Ikona(210,252,430,370,0,' ');
  255.      SetTextStyle(0,0,2);
  256.      SetColor(1);
  257.      OutTextXY(238,177,'WARNING !!!');
  258.      SetColor(5);
  259.      OutTextXY(237,176,'WARNING !!!');
  260.      SetColor(4);
  261.      OutTextXY(236,175,'WARNING !!!');
  262.      SetColor(13);
  263.      OutTextXY(235,174,'WARNING !!!');
  264.      SetTextStyle(0,0,1);
  265.      SetColor(9);
  266.      OutTextXY(221,212,'Delete also include wipe !');
  267.      SetColor(15);
  268.      OutTextXY(219,210,'Delete also include wipe !');
  269.      SetColor(9);
  270.      OutTextXY(221,221,'Deleted  files  cannot  be');
  271.      SetColor(15);
  272.      OutTextXY(219,219,'Deleted  files  cannot  be');
  273.      SetColor(9);
  274.      OutTextXY(221,231,'undeleted  in  any  way  !');
  275.      SetColor(15);
  276.      OutTextXY(219,229,'undeleted  in  any  way  !');
  277.      SetColor(8);
  278.      OutTextXY(270,260,'Erase & Wipe');
  279.      SetColor(15);
  280.      OutTextXY(268,258,'Erase & Wipe');
  281.      SetColor(9);
  282.      OutTextXY(270,280,'command1.com');
  283.      SetColor(15);
  284.      OutTextXY(268,278,'command1.com');
  285.      SetColor(9);
  286.      OutTextXY(305,290,'arhs');
  287.      SetColor(15);
  288.      OutTextXY(303,288,'arhs');
  289.      SetColor(9);
  290.      OutTextXY(282,300,'123456789');
  291.      SetColor(15);
  292.      OutTextXY(280,298,'123456789');
  293.      SetColor(9);
  294.      OutTextXY(279,310,'22-12-1994');
  295.      SetColor(15);
  296.      OutTextXY(277,308,'22-12-1994');
  297.      SetColor(9);
  298.      OutTextXY(286,320,'12:12:12');
  299.      SetColor(15);
  300.      OutTextXY(284,318,'12:12:12');
  301.      Ikona(237,342,273,360,0,' ');
  302.      Ikona(240,345,270,357,0,'Yes');
  303.      Ikona(297,342,325,360,0,' ');
  304.      Ikona(300,345,322,357,0,'No');
  305.      Ikona(349,342,407,360,0,' ');
  306.      Ikona(352,345,404,357,0,'Always');
  307. { ********* end of graphic **************}
  308.      Save_Image_in_Temp_Files(0,0,639,479);  {Save whole screen to file}
  309.      REPEAT UNTIL Keypressed;
  310. END.
  311.  
  312. {***************************************************************************}
  313.  
  314. {                        Show saved image to screen
  315.  
  316. {***************************************************************************}
  317. Program ShowPic;
  318. USES Graph, Dos, CRT;
  319. Var GD, GM: Integer;
  320.     X, Y, Button: Integer ;
  321.     hmm: Boolean;
  322.     Size,Result: Word;
  323.     P: Pointer;
  324.     Ch: Char;
  325.     f: File;
  326.     g: File Of Word;
  327.     h: File Of Integer;
  328.  
  329. Procedure CIkona(x1,y1,x2,y2,text:integer;tekstikone:string); {Ikone}
  330.   Begin
  331.    SetColor(White);
  332.    SetFillStyle(SolidFill,2);
  333.    Bar(x1,y1,x2,y2);
  334.    SetColor(Black);
  335.    SetLineStyle(0,0,1);
  336.    Rectangle(x1-1,y1-2,x2+1,y2+1);
  337.    SetColor(White);
  338.    Line(x1,y1-1,x2,y1-1);
  339.    Line(x1,y1,x1,y2-1);
  340.    SetColor(DarkGray);
  341.    Line(x1+1,y2,x2,y2);
  342.    Line(x2,y2,x1,y2);
  343.    SetTextStyle(0,0,0);
  344.    SetColor(DarkGray);
  345.    OutTextXY(x1+5,y1+4+text,TekstIkone);
  346.    SetColor(White);
  347.    OutTextXY(x1+3,y1+2+text,TekstIkone);
  348.   end {Ikona};
  349.  
  350. Procedure Ikona(x1,y1,x2,y2,text:integer;tekstikone:string); {Ikone}
  351.   Begin
  352.    SetColor(White);
  353.    SetFillStyle(SolidFill,LightGray);
  354.    Bar(x1,y1,x2,y2);
  355.    SetColor(Black);
  356.    SetLineStyle(0,0,1);
  357.    Rectangle(x1-1,y1-2,x2+1,y2+1);
  358.    SetColor(White);
  359.    Line(x1,y1-1,x2,y1-1);
  360.    Line(x1,y1,x1,y2-1);
  361.    SetColor(DarkGray);
  362.    Line(x1+1,y2,x2,y2);
  363.    Line(x2,y2,x1,y2);
  364.    SetTextStyle(0,0,0);
  365.    SetColor(DarkGray);
  366.    OutTextXY(x1+5,y1+4+text,TekstIkone);
  367.    SetColor(White);
  368.    OutTextXY(x1+3,y1+2+text,TekstIkone);
  369.   end {Ikona};
  370.  
  371. Procedure BIkona(x1,y1,x2,y2,text:integer;tekstikone:string);  {Stisnuta Ikona}  Begin
  372.    SetColor(White);
  373.    SetFillStyle(SolidFill,LightGray);
  374.    Bar(x1,y1,x2,y2);
  375.    SetColor(Black);
  376.    SetLineStyle(0,0,1);
  377.    Rectangle(x1-1,y1-2,x2+1,y2+1);
  378.    SetColor(Black);
  379.    Line(x1,y1-1,x2,y1-1);
  380.    Line(x1,y1,x1,y2-1);
  381.    SetColor(DarkGray);
  382.    Line(x1+1,y2,x2,y2);
  383.    Line(x2,y2,x1,y2);
  384.    SetTextStyle(0,0,0);
  385.    SetColor(White);
  386.    OutTextXY(x1+5,y1+4+text,TekstIkone);
  387.    SetColor(DarkGray);
  388.    OutTextXY(x1+3,y1+2+text,TekstIkone);
  389.    Delay(300);
  390.   end {Bikona};
  391.  
  392. Procedure TS(Var ad:Text; Pos:LongInt); {Seek for Text Files}
  393. Type dW=Array[0..1] of Word;
  394. Var ap:LongInt;
  395.     ds: LongInt;
  396.     Rg:Registers;
  397.     erg:LongInt;
  398. begin
  399.      With Rg do
  400.      begin
  401.           ah:=$42;
  402.           al:=1;
  403.           bx:=TextRec(ad).Handle;
  404.           cx:=dW(Pos)[1];
  405.           dx:=dW(Pos)[0];
  406.           MSDos(Rg);
  407.           if Flags and fCarry<>0 then
  408.           begin
  409.                InOutRes:=ax;
  410.                ds:=0
  411.           end
  412.           else ds:=rg.ax+rg.dx*65536;
  413.      end;
  414.      ap:=ds-TextRec(ad).Bufend+TextRec(ad).BufPos;
  415.      if ap<>pos then With Textrec(ad) do
  416.      begin
  417.           if Mode=fmOutput then flush(ad);
  418.           With Textrec(ad) do
  419.           begin
  420.                if (ap+(bufend-bufpos)<Pos) or (ap>Pos) then
  421.                begin
  422.                     bufpos:=0;
  423.                     bufend:=0;
  424.                     With Rg do
  425.                     begin
  426.                          ah:=$42;
  427.                          al:=0;
  428.                          bx:=TextRec(ad).Handle;
  429.                          cx:=dW(pos)[1];
  430.                          dx:=dW(pos)[0];
  431.                          MSDos(Rg);
  432.                          if Flags and fCarry<>0 then
  433.                          begin
  434.                               InOutRes:=ax;
  435.                               ds:=0
  436.                          end
  437.                          else ds:=rg.ax+rg.dx*65536;
  438.                     end;
  439.                end
  440.                else
  441.                begin
  442.                     inc(bufpos, pos-ap);
  443.                end;
  444.           end;
  445.      end;
  446. end;
  447.  
  448. PROCEDURE Make_Image_Temp_Files;
  449. VAR ch: Char;
  450.     k,KK,Per,Per1:LongInt;
  451.     m,pos: Integer;
  452.     st: String;
  453.     d: TEXT;
  454.     e,z,w: File Of Char;
  455.     ok:Boolean;
  456.  
  457. BEGIN
  458.      ikona(170,180,470,300,0,' ');
  459.      Bikona(175,185,465,295,0,' ');
  460.      ikona(180,190,460,290,0,' ');
  461.      SetColor(8);
  462.      OutTextXY(258,198,'Reading Image');
  463.      SetColor(15);
  464.      OutTextXY(256,196,'Reading Image');
  465.      Ikona(210,235,430,265,0,' ');
  466.      Bikona(215,240,425,260,0,' ');
  467.      Assign(d,'IMAGE.AID');
  468.      Reset(d);
  469.      TS(d,84);
  470.      st:='';
  471.      FOR kk:=1 TO 7 DO
  472.      BEGIN
  473.           Read(d, Ch);
  474.           st:=st+ch;
  475.      END;
  476.      IF (st='AISD/3 ') THEN OK:=True;
  477.      IF ok THEN
  478.      BEGIN
  479.           Readln(d,k);
  480.           Assign(e,'IMAGE2.TMP');
  481.           REWRITE(e);
  482.           FOR kk:=1 TO k DO
  483.           BEGIN
  484.                Read(d,ch);
  485.                Write(e,ch);
  486.           END;
  487.           Readln(d);
  488.           Close(e);
  489.      END;
  490.      ok:=False;
  491.      st:='';
  492.      FOR kk:=1 TO 7 DO
  493.      BEGIN
  494.           Read(d,ch);
  495.           st:=st+ch;
  496.      END;
  497.      IF (st='AIDD/3 ') THEN ok:=True;
  498.      IF ok THEN
  499.      BEGIN
  500.           Readln(d,k);
  501.           ASSIGN(w,'IMAGE3.TMP');
  502.           REWRITE(w);
  503.           FOR kk:=1 TO k DO
  504.           BEGIN
  505.                Read(d,ch);
  506.                Write(w,ch);
  507.           END;
  508.           Readln(d);
  509.           Close(w);
  510.      END;
  511.      ok:=False;
  512.      st:='';
  513.      FOR kk:=1 TO 6 DO
  514.      BEGIN
  515.           Read(d,ch);
  516.           st:=st+ch;
  517.      END;
  518.      IF (st='AID/3 ') THEN ok:=True;
  519.      IF ok THEN
  520.      BEGIN
  521.           Readln(d,k);
  522.           per:=k DIV 100;
  523.           per1:=Per;
  524.           m:=0;
  525.           pos:=0;
  526.           ASSIGN(z,'IMAGE1.TMP');
  527.           REWRITE(z);
  528.           FOR kk:=1 TO k DO
  529.           BEGIN
  530.                Read(d,ch);
  531.                Write(z,ch);
  532.                IF kk=per THEN
  533.                BEGIN
  534.                     m:=m+2;
  535.                     { ******* Bar for reading image *********}
  536.                     CIkona(220,245,220+m,255,0,' ');
  537.                     Per:=Per+Per1;
  538.                     pos:=pos+1;
  539.                     Str(pos,st);
  540.                     st:=st+' %';
  541.                     SetFillStyle(1,7);
  542.                     Bar(307,211,340,229);
  543.                     SetColor(8);
  544.                     OutTextXY(310,220,st);
  545.                     SetColor(15);
  546.                     OutTextXY(308,218,st);
  547.                END;
  548.           END;
  549.           Close(z);
  550.      END;
  551.      Close(d);
  552.      ClearDevice;
  553. END;
  554.  
  555. PROCEDURE Show_Pic(X,Y : Integer);  {This shows image}
  556. VAR k: Integer;
  557. BEGIN
  558.      Assign(F,'IMAGE1.TMP');
  559.      reset(F,1);
  560.      Assign(g, 'IMAGE2.TMP');
  561.      Reset(g);
  562.      ASSIGN(h,'IMAGE3.TMP');
  563.      Reset(h);
  564.  
  565.      Read(g,Size);
  566.      GetMem(P,Size);
  567.      BlockRead(F,P^,Size,Result);
  568.      PutImage(X,Y,P^,NormalPut);
  569.      FreeMem(P,Size);
  570.  
  571.      Read(h,k);
  572.      Read(g,Size);
  573.      GetMem(P,Size);
  574.      BlockRead(F,P^,Size,Result);
  575.      PutImage(x,y+k,P^,NormalPut);
  576.      FreeMem(P,Size);
  577.  
  578.      Read(g,Size);
  579.      GetMem(P,Size);
  580.      BlockRead(F,P^,Size,Result);
  581.      PutImage(x,y+(k*2),P^,NormalPut);
  582.      FreeMem(P,Size);
  583.      Rewrite(f);
  584.      close(F);
  585.      Erase(f);
  586.      Rewrite(g);
  587.      Close(g);
  588.      Erase(g);
  589. END;
  590.  
  591. BEGIN
  592.      ClrScr;
  593.      Gd:=Detect;
  594.      InitGraph(Gd, Gm, '\turbo\tp\'); { CHANGE THIS !! }
  595.      if GraphResult <> grOk then Halt(1);
  596.      IF Gd<>9 THEN
  597.      BEGIN
  598.           SetColor(White);
  599.           OutTextXY(10, GetMaxY DIV 2, 'Sorry but this was tested only on VGA');
  600.           OutTextXY(10, (GetMaxY DIV 2)+10, 'It will probably work on other card,');
  601.           OutTextXY(10, (GetMaxY DIV 2)+20, 'but all graphics here are for 640x480x16');
  602.           OutTextXY(10, (GetMaxY DIV 2)+40, 'All you have to do is to remove this lines');
  603.           OutTextXY(10, (GetMaxY DIV 2)+50, 'and try. Probably you need to change something');
  604.           OutTextXY(10, (GetMaxY DIV 2)+10, 'like colors, constants and so on ...');
  605.           Delay(10000);
  606.           CloseGraph;
  607.           Halt(1);
  608.      END;
  609.      Make_Image_Temp_Files;
  610.      Show_Pic(0,0);
  611.      REPEAT UNTIL Keypressed;
  612. END.
  613.  
  614.